perm filename NOTWRT.F4[P11,LCS] blob sn#585798 filedate 1981-05-13 generic text, type T, neo UTF8
C**** NOTWRT, STEM

	SUBROUTINE NOTWRT
	COMMON /INTGRS/JACC,JTAIL,JDOT,NTYPE,JSTEM,JWHOLE
	COMMON /STF/RSTFAC(0/7),RSTJ2 /WIDTH/WID1,WID2,WIDX
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
	COMMON /POSI/STFF(0/7),JJ2,POS
C  ITEMS IN FOLLOWING COMMON BLOCK ARE USED IN 'TAILS' AND 'FERM'
	COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
	1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,RZTM,RXX,JJJ,
	1 PUNCT,JY,RJ
	EQUIVALENCE (J4,JQ(2)),(J5,JQ(3)),(R4,RJQ(2)),(J9,JQ(7))
	1,(R6,RJQ(4)),(J7,JQ(5)),(J10,JQ(8)),(J11,JQ(9)),(J6,JQ(4))
 	1,(R3,RJQ(1)),(RX4,JQ(19)),(R12,RJQ(10)),(RLVL,RJQ(20))
	1,(R7,RJQ(5))
	DATA WID1/14.54/,WID2/16.2/

C  NOTES****
	RMINI=RSTJ2
	RST7=7.*RMINI
	IF(JA.EQ.1)GO TO 11
	IF(JA.NE.9)GO TO 90
	CALL MRKX
	RETURN
90	CALL RST
C GO MAKE A REST
	RETURN
11	JSTEM=J5/10
	JWHOLE=IABS(J6)
	IF(JWHOLE.EQ.30)JWHOLE=0
C   30 IS USED IN NOTBMS & RHYTH.
	JACC=MOD(J5,10)
C  THE ACCIDENTAL NUM.
	JTAIL=MOD(J7,10)
C  HOW MANY TAILS
	JDOT=J7/10
C HOW MANY DOTS
	NTYPE=(IABS(J4)+20)/100
C NOTE TYPE CODE NUMBER (0,1,2,3,4,5)
	RLVL=AMOD(R4,100.)
C TRUE LEVEL OF NOTE.  USED IN ACCI.
	IF(J10.LE.0)GO TO 9
	POS=STFF(J2-3+2*J10)
C  FOR PUTTING NOTES ON STAFF ABOVE OR BELOW. J10=1=DOWN, =2=UP
	CALL CENTX
9	MKS=J11
C ANY MARKS?
	JJ4=RLVL
	RJAC=R3
C  SAVE HOR. POS. FOR OTHER ROUTINES
	IF(R12.NE.0)RMINI=RMINI*R12
C  R12 HAS NEW, MASTER SIZE FACTOR
	GO TO (1,2,3,3,5,6)NTYPE+1
1	CALL ORDNT
7	IF(JJ4.LT.2)GO TO 8
	IF(JJ4.LT.13)GO TO 10
8	IF(J9.NE.-1)CALL LDGLN
10	IF(JDOT.EQ.0)GO TO 12
	RJX=RJAC+(22.+AMOD(R7,1.0)*59.6)*RMINI
C RJAC IS ORIGINAL R3  (RESTS ALSO USE DOTIT)
	CALL DOTIT
12	IF(JACC.NE.0)CALL ACCI
	IF(JSTEM.GT.0)CALL STEM
	IF(JTAIL.NE.0)CALL TAILS
	IF(MKS.NE.0)CALL MRK
	RETURN
2	RMINI=RMINI*.6
C FOR MINI (GRACE) NOTES
	GO TO 1
3	CALL DIAMND
	GO TO 7
5	RB=R6*RST7
C USE R6 TO ADJUST SOURCE POS. OF HEADLESS NOTES (WAS R12)
	J6=0
	GO TO 7
6	CALL EXTRA
C  GO USE SPECIAL NOTE PACKAGE
	END

	SUBROUTINE STEM
	COMMON /INTGRS/JACC,JTAIL,JDOT,NTYPE,JSTEM
	COMMON /STF/RSTFAC(0/7),RSTJ2 /WIDTH/WID1,WID2,WIDX
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
C  ITEMS IN FOLLOWING COMMON BLOCK ARE USED IN 'TAILS' AND 'FERM'
	COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
	1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,RZTM,RXX,JJJ,PUNCT,JY,RJ
	EQUIVALENCE (J5,JQ(3)),(J7,JQ(5)),(J10,JQ(8)),
 	1(J6,JQ(4)),(R5,RJQ(3)) ,(R8,RJQ(6)),(R3,RJQ(1))
	RG=(JTAIL-1)*14
	IF(RG.LT.0)RG=0
C 999 IS STANDARD (0) STEM LENGTH.
	IF(R8.NE.999.)GO TO 1751
	R8=0
	RH=0
	GO TO 2751
1751	IF(R8.LT.999.)GO TO 751
	R8=R8-1000.
	J10=-1 
C   +1000  PUTS SLASH ON NOTE STEM
751	RH=R8*RST7
2751	IF(JSTEM.NE.2)GO TO 1280
C   STEM EXTENSIONS ARE BY NOTE #S
	RJX=R3
C   FOR STEM DOWN (=2)
	RG=-RG-48.
	RH=-RH
C RB IS SOURCE POS. OF STEM.  SET UP IN VARIOUS NOTE ROUTINES.
	 RB=-RB
C  FOR TILT OF ORDINARY NOTES (NOT X OR DIAMOND)
	GO TO 129
C   NEXT IS FOR STEM UP.
1280	RJX=WIDX
CC	IF(J6.LT.0)RJX=WID2
C IF(J6.LT.0)GET SPACE FOR HALF NOTE
2322	RJX=RJX*RMINI+R3
	 RG=RG+48.
129	RZ=CENTR+RH+RG*RMINI
	RB=RB+CENTR
	CALL LINX(RJX,RB,RJX,RZ)
C MOVES CENTR UP OR DOWN FOR NEXT TAIL
	END